unit frmDisplay;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,FMX.Graphics, FMX.Colors;

type
    TQuadColor = record
      class operator Implicit(const Value: TQuadColor): TAlphaColor;
      case Boolean of
        True : (Blue,
                Green,
                Red,
                Alpha : Byte);
        False : (Quad : Cardinal);
    end;
    PQuadColor = ^TQuadColor;
    PPQuadColor = ^PQuadColor;


  TLetterMap = array[byte] of TBitMap;
  pLetterMap = ^TLetterMap;
  TThing = record
    FDeltaColor: Single;
    FLevel: Single;
    FPt: TPointF;
    FMap: pLetterMap;
    FLetter: Char;
    const _Width = 12;
    const _Height = 18;
    const _FontSize = 19;
    const _FontName = 'Consolas';
    procedure Init(APt: TPointF; ALevel: Single;ADelta: Single; AMap: pLetterMap; ALetter: Char);
    procedure Update(Canvas: TCanvas);
    class procedure _Draw(Canvas: TCanvas; Pt: TPointF;Letter: Char; Level: Single); static;
    procedure Draw(Canvas: TCanvas);
    procedure Draw2(Canvas: TCanvas);
  end;

  TForm5 = class(TForm)
    Timer1: TTimer;
    procedure FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    Things: array of TThing;
    Characters:array[boolean,byte] of TBitMap;
  protected
    { Public declarations }
  end;

var
  Form5: TForm5;

implementation

{$R *.fmx}

procedure TForm5.FormCreate(Sender: TObject);
var
  I: Byte;
  B: Boolean;
begin
  for B := False to True do
    for I := 0 to 255 do begin
      Characters[B,I] := TBitMap.Create(TThing._Width,TThing._Height);
      with Characters[B,I] do begin
        Canvas.BeginScene;
        TThing._Draw(Canvas,PointF(0,0),Char(Ord(B)+Ord('0')),I/255);
        Canvas.EndScene;
      end;
    end;
  FormResize(nil);
end;

procedure TForm5.FormPaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var
  Index: Integer;
begin
//  Canvas.BeginScene;
  for Index := Low(Things) to High(Things) do
    Things[Index].Draw(Canvas);
//  Canvas.EndScene;
end;

procedure TForm5.FormResize(Sender: TObject);
var
  Pt: TPointF;
  Letter: Char;
begin
  SetLength(Things,0);
  Pt := PointF(0,0);
  while Pt.Y < Height do begin
    while Pt.X < Width do begin
      Letter := Char(Random(2)+Ord('0'));
      SetLength(Things,Length(Things)+1);
      Things[High(Things)].Init(Pt,Random,Random*0.05+0.01,@Characters[Letter = '1'],Letter);
      Pt.X := Pt.X + TThing._Width;
    end;
    Pt.X := 0;
    Pt.Y := Pt.Y + TThing._Height;
  end;
end;

procedure TForm5.Timer1Timer(Sender: TObject);
var
  Index: Integer;
begin
  for Index := Low(Things) to High(Things) do
    Things[Index].Update(Canvas);
  Invalidate;
end;

{ TThing }

procedure TThing.Draw(Canvas: TCanvas);
var
  BM: TBitMap;
  PositionRect: TRectF;
begin
  BM := FMap^[Round($FF*FLevel)];
  PositionRect := RectF(FPt.X,FPt.Y,FPt.X+BM.Width,FPt.Y+BM.Height);
//  Draw(Canvas,'0',255);
  Canvas.DrawBitmap(BM,RectF(0,0,BM.Width,BM.Height),PositionRect,1,True);
end;


procedure TThing.Draw2(Canvas: TCanvas);
begin
  _Draw(Canvas,FPt,FLetter,FLevel);
end;

class procedure TThing._Draw(Canvas: TCanvas; Pt: TPointF;Letter: Char; Level: Single);
var
  Color: TQuadColor;
  Bounds: TRectF;
begin
  Bounds := RectF(Pt.X,Pt.Y,Pt.X+_Width,Pt.X+_Height);



  // Erase background
  Canvas.Fill.Color := TAlphaColors.Black;
  Canvas.FillRect(Bounds,0,0,[],1);

  Color.Red := Round($6F * (Level));
  Color.Green := Round($FF * (Level));
  Color.Blue := Round($6F * (Level));
  Color.Alpha := 255;

  // Draw Letter
  Canvas.Font.Family := _FontName;
  Canvas.Fill.Color := Color;
  Canvas.Font.Size := _FontSize;
  Canvas.Stroke.Kind := TBrushKind.bkSolid;
  Canvas.StrokeThickness := 1;

  Canvas.FillText(Bounds, Letter, false, 100, [TFillTextFlag.ftRightToLeft],TTextAlign.taCenter, TTextAlign.taCenter);
end;

procedure TThing.Init(APt: TPointF; ALevel: Single;ADelta: Single; AMap: pLetterMap; ALetter: Char);
begin
  FPt := APt;
  FDeltaColor := ADelta;
  FLevel := ALevel;
  FMap := AMap;
end;

procedure TThing.Update(Canvas: TCanvas);
begin
  if (FDeltaColor + FLEvel < 0) or (FDeltaColor + FLevel > 1) then
    FDeltaColor := -FDeltaColor;
  FLevel := FDeltaColor + FLevel;
end;


{ TQuadColor }

class operator TQuadColor.Implicit(const Value: TQuadColor): TAlphaColor;
begin
  Result := Value.Quad;
end;

end.
